home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / packages / icomplete.el.z / icomplete.el
Encoding:
Text File  |  1998-05-21  |  13.3 KB  |  362 lines
  1. ;;;_. icomplete.el - minibuffer completion incremental feedback
  2.  
  3. ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Ken Manheimer <klm@python.org>
  6. ;; Maintainer: Ken Manheimer <klm@python.org>
  7. ;; Version: $Id: icomplete.el,v 4.10 1997/05/30 22:01:13 klm Exp $
  8. ;; Created: Mar 1993 klm@nist.gov - first release to usenet
  9. ;; Keywords: help, abbrev
  10.  
  11. ;; This file is part of GNU Emacs.
  12.  
  13. ;; GNU Emacs is free software; you can redistribute it and/or modify
  14. ;; it under the terms of the GNU General Public License as published by
  15. ;; the Free Software Foundation; either version 2, or (at your option)
  16. ;; any later version.
  17.  
  18. ;; GNU Emacs is distributed in the hope that it will be useful,
  19. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21. ;; GNU General Public License for more details.
  22.  
  23. ;; You should have received a copy of the GNU General Public License
  24. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26. ;; Boston, MA 02111-1307, USA.
  27.  
  28. ;; This file is also part of GNU XEmacs.
  29. ;; Hacked for GNU XEmacs: David Hughes 7th September 1995.
  30. ;; Icomplete keybindings display originally by Steve Bauer, with
  31. ;; some integration and refinement by Ken Manheimer.
  32.  
  33. ;;; Commentary:
  34.  
  35. ;; Loading this package implements a more fine-grained minibuffer
  36. ;; completion feedback scheme.  Prospective completions are concisely
  37. ;; indicated within the minibuffer itself, with each successive
  38. ;; keystroke.
  39.  
  40. ;; See 'icomplete-completions' docstring for a description of the
  41. ;; icomplete display format.
  42.  
  43. ;; See the `icomplete-minibuffer-setup-hook' docstring for a means to
  44. ;; customize icomplete setup for interoperation with other
  45. ;; minibuffer-oriented packages.
  46.  
  47. ;; To activate icomplete mode, load the package and use the
  48. ;; `icomplete-mode' function.  You can subsequently deactivate it by
  49. ;; invoking the function icomplete-mode with a negative prefix-arg
  50. ;; (C-U -1 ESC-x icomplete-mode).  Also, you can prevent activation of
  51. ;; the mode during package load by first setting the variable
  52. ;; `icomplete-mode' to nil.  Icompletion can be enabled any time after
  53. ;; the package is loaded by invoking icomplete-mode without a prefix
  54. ;; arg.
  55.  
  56. ;; Thanks to everyone for their suggestions for refinements of this
  57. ;; package.  I particularly have to credit Michael Cook, who
  58. ;; implemented an incremental completion style in his 'iswitch'
  59. ;; functions that served as a model for icomplete.  Some other
  60. ;; contributors: Noah Freidman (restructuring as minor mode), Colin
  61. ;; Rafferty (lemacs reconciliation), Lars Lindberg, RMS, and others.
  62.  
  63. ;; klm.
  64.  
  65. ;;; Code:
  66.  
  67. ;;;_* Provide
  68. (provide 'icomplete)
  69.  
  70. (defgroup icomplete nil
  71.   "Minibuffer completion incremental feedback."
  72.   :group 'minibuffer)
  73.  
  74.  
  75. (defcustom icomplete-mode nil
  76.   "*Non-nil activates incremental minibuffer completion."
  77.   :type 'boolean
  78.   :set (lambda (symbol value)
  79.      (icomplete-mode (if value 1 -1)))
  80.   :initialize 'custom-initialize-default
  81.   :require 'icomplete
  82.   :group 'icomplete)
  83.  
  84. ;;;_* User Customization variables
  85. (defcustom icomplete-prospects-length 80
  86.   "*Length of string displaying the prospects."
  87.   :type 'integer
  88.   :group 'icomplete)
  89. (defcustom icomplete-compute-delay .3
  90.   "*Completions-computation stall, used only with large-number
  91. completions - see `icomplete-delay-completions-threshold'."
  92.   :type 'number
  93.   :group 'icomplete)
  94. (defcustom icomplete-delay-completions-threshold 400
  95.   "*Pending-completions number over which to apply icomplete-compute-delay."
  96.   :type 'integer
  97.   :group 'icomplete)
  98. (defcustom icomplete-max-delay-chars 3
  99.   "*Maximum number of initial chars to apply icomplete compute delay."
  100.   :type 'integer
  101.   :group 'icomplete)
  102.  
  103. ;;;_* Initialization
  104. ;;;_  = icomplete-minibuffer-setup-hook
  105. (defcustom icomplete-minibuffer-setup-hook nil
  106.   "*Icomplete-specific customization of minibuffer setup.
  107.  
  108. This hook is run during minibuffer setup iff icomplete will be active.
  109. It is intended for use in customizing icomplete for interoperation
  110. with other packages.  For instance:
  111.  
  112.   \(add-hook 'icomplete-minibuffer-setup-hook
  113.         \(function
  114.          \(lambda ()
  115.            \(make-local-variable 'resize-minibuffer-window-max-height)
  116.            \(setq resize-minibuffer-window-max-height 3))))
  117.  
  118. will constrain rsz-mini to a maximum minibuffer height of 3 lines when
  119. icompletion is occurring."
  120.   :type 'hook
  121.   :group 'icomplete)
  122.  
  123. ;;;_ + Internal Variables
  124. ;;;_  = icomplete-mode
  125. ;(defvar icomplete-mode t
  126. ;  "*Nil inhibits activated incremental minibuffer completion.")
  127. ;;;_  = icomplete-eoinput 1
  128. (defvar icomplete-eoinput 1
  129.   "Point where minibuffer input ends and completion info begins.")
  130. (make-variable-buffer-local 'icomplete-eoinput)
  131. ;;;_  = icomplete-pre-command-hook
  132. (defvar icomplete-pre-command-hook nil
  133.   "Incremental-minibuffer-completion pre-command-hook.
  134.  
  135. Is run in minibuffer before user input when `icomplete-mode' is non-nil.
  136. Use `icomplete-mode' function to set it up properly for incremental
  137. minibuffer completion.")
  138. (add-hook 'icomplete-pre-command-hook 'icomplete-tidy)
  139. ;;;_  = icomplete-post-command-hook
  140. (defvar icomplete-post-command-hook nil
  141.   "Incremental-minibuffer-completion post-command-hook.
  142.  
  143. Is run in minibuffer after user input when `icomplete-mode' is non-nil.
  144. Use `icomplete-mode' function to set it up properly for incremental
  145. minibuffer completion.")
  146. (add-hook 'icomplete-post-command-hook 'icomplete-exhibit)
  147.  
  148. (defvar icomplete-show-key-bindings t
  149.   "When non-nil, show key bindings as well as completion for sole matches.")
  150.  
  151. (defun icomplete-get-keys (func-name)
  152.   "Return strings naming keys bound to `func-name', or nil if none.
  153. Examines the prior, not current, buffer, presuming that current buffer
  154. is minibuffer."
  155.   (if (commandp func-name)
  156.     (save-excursion
  157.       (let* ((sym (intern func-name))
  158.          (buf (other-buffer))
  159.          (map (save-excursion (set-buffer buf) (current-local-map)))
  160.          (keys (where-is-internal sym map)))
  161.     (if keys
  162.         (concat "<"
  163.             (mapconcat 'key-description
  164.                    (sort keys
  165.                      #'(lambda (x y)
  166.                      (< (length x) (length y))))
  167.                    ", ")
  168.             ">"))))))
  169.  
  170. ;;;_ > icomplete-mode (&optional prefix)
  171. ;;;###autoload
  172. (defun icomplete-mode (&optional prefix)
  173.   "Activate incremental minibuffer completion for this emacs session.
  174. Deactivates with negative universal argument."
  175.   (interactive "p")
  176.   (or prefix (setq prefix 0))
  177.   (cond ((>= prefix 0)
  178.      (setq icomplete-mode t)
  179.      ;; The following is not really necessary after first time -
  180.      ;; no great loss.
  181.      (add-hook 'minibuffer-setup-hook 'icomplete-minibuffer-setup))
  182.     (t (setq icomplete-mode nil))))
  183.  
  184. ;;;_ > icomplete-simple-completing-p ()
  185. (defun icomplete-simple-completing-p ()
  186.   "Non-nil if current window is minibuffer that's doing simple completion.
  187.  
  188. Conditions are:
  189.    the selected window is a minibuffer,
  190.    and not in the middle of macro execution,
  191.    and minibuffer-completion-table is not a symbol (which would
  192.        indicate some non-standard, non-simple completion mechanism,
  193.        like file-name and other custom-func completions)."
  194.  
  195.   (and (window-minibuffer-p (selected-window))
  196.        (not executing-kbd-macro)
  197.        (not (symbolp minibuffer-completion-table))))
  198.  
  199. ;;;_ > icomplete-minibuffer-setup ()
  200. ;;;###autoload
  201. (defun icomplete-minibuffer-setup ()
  202.   "Run in minibuffer on activation to establish incremental completion.
  203. Usually run by inclusion in `minibuffer-setup-hook'."
  204.   (cond ((and icomplete-mode (icomplete-simple-completing-p))
  205.      (make-local-hook 'pre-command-hook)
  206.      (add-hook 'pre-command-hook
  207.            (function (lambda ()
  208.                    (run-hooks 'icomplete-pre-command-hook)))
  209.            nil t)
  210.      (make-local-hook 'post-command-hook)
  211.      (add-hook 'post-command-hook
  212.            (function (lambda ()
  213.                    (run-hooks 'icomplete-post-command-hook)))
  214.            nil t)
  215.      (run-hooks 'icomplete-minibuffer-setup-hook))))
  216.  
  217. ;;;_* Completion
  218.  
  219. ;;;_ > icomplete-tidy ()
  220. (defun icomplete-tidy ()
  221.   "Remove completions display \(if any) prior to new user input.
  222. Should be run in on the minibuffer `pre-command-hook'.  See `icomplete-mode'
  223. and `minibuffer-setup-hook'."
  224.   (if (icomplete-simple-completing-p)
  225.       (if (and (boundp 'icomplete-eoinput)
  226.            icomplete-eoinput)
  227.  
  228.       (if (> icomplete-eoinput (point-max))
  229.           ;; Oops, got rug pulled out from under us - reinit:
  230.           (setq icomplete-eoinput (point-max))
  231.         (let ((buffer-undo-list buffer-undo-list )) ; prevent entry
  232.           (delete-region icomplete-eoinput (point-max))))
  233.  
  234.     ;; Reestablish the local variable 'cause minibuffer-setup is weird:
  235.     (make-local-variable 'icomplete-eoinput)
  236.     (setq icomplete-eoinput 1))))
  237.  
  238. ;;;_ > icomplete-exhibit ()
  239. (defun icomplete-exhibit ()
  240.   "Insert icomplete completions display.
  241. Should be run via minibuffer `post-command-hook'.  See `icomplete-mode'
  242. and `minibuffer-setup-hook'."
  243.   (if (icomplete-simple-completing-p)
  244.       (let ((contents (buffer-substring (point-min)(point-max)))
  245.         (buffer-undo-list t))
  246.     (save-excursion
  247.       (goto-char (point-max))
  248.                                         ; Register the end of input, so we
  249.                                         ; know where the extra stuff
  250.                                         ; (match-status info) begins:
  251.       (if (not (boundp 'icomplete-eoinput))
  252.           ;; In case it got wiped out by major mode business:
  253.           (make-local-variable 'icomplete-eoinput))
  254.       (setq icomplete-eoinput (point))
  255.                                         ; Insert the match-status information:
  256.       (if (and (> (point-max) 1)
  257.            (or
  258.             ;; Don't bother with delay after certain number of chars:
  259.             (> (point-max) icomplete-max-delay-chars)
  260.             ;; Don't delay if alternatives number is small enough:
  261.             (if minibuffer-completion-table
  262.             (cond ((numberp minibuffer-completion-table)
  263.                    (< minibuffer-completion-table
  264.                   icomplete-delay-completions-threshold))
  265.                   ((sequencep minibuffer-completion-table)
  266.                    (< (length minibuffer-completion-table)
  267.                   icomplete-delay-completions-threshold))
  268.                   ))
  269.             ;; Delay - give some grace time for next keystroke, before
  270.             ;; embarking on computing completions:
  271.             (sit-for icomplete-compute-delay)))
  272.           (insert-string
  273.            (icomplete-completions contents
  274.                       minibuffer-completion-table
  275.                       minibuffer-completion-predicate
  276.                       (not
  277.                        minibuffer-completion-confirm))))))))
  278.  
  279. ;;;_ > icomplete-completions (name candidates predicate require-match)
  280. (defun icomplete-completions (name candidates predicate require-match)
  281.   "Identify prospective candidates for minibuffer completion.
  282.  
  283. The display is updated with each minibuffer keystroke during
  284. minibuffer completion.
  285.  
  286. Prospective completion suffixes (if any) are displayed, bracketed by
  287. one of \(), \[], or \{} pairs.  The choice of brackets is as follows:
  288.  
  289.   \(...) - a single prospect is identified and matching is enforced,
  290.   \[...] - a single prospect is identified but matching is optional, or
  291.   \{...} - multiple prospects, separated by commas, are indicated, and
  292.           further input is required to distinguish a single one.
  293.  
  294. The displays for unambiguous matches have ` [Matched]' appended
  295. \(whether complete or not), or ` \[No matches]', if no eligible
  296. matches exist.  \(Keybindings for uniquely matched commands are
  297. exhibited within the square braces.)"
  298.  
  299.   ;; 'all-completions' doesn't like empty
  300.   ;; minibuffer-completion-table's (ie: (nil))
  301.   (if (and (listp candidates) (null (car candidates)))
  302.       (setq candidates nil))
  303.  
  304.   (let ((comps (all-completions name candidates predicate))
  305.                                         ; "-determined" - only one candidate
  306.         (open-bracket-determined (if require-match "(" "["))
  307.         (close-bracket-determined (if require-match ")" "]")))
  308.     ;; `concat'/`mapconcat' is the slow part.  With the introduction of
  309.     ;; `icomplete-prospects-length', there is no need for `catch'/`throw'.
  310.     (if (null comps) (format " %sNo matches%s"
  311.                  open-bracket-determined
  312.                  close-bracket-determined)
  313.       (let* ((most-try (try-completion name (mapcar (function list) comps)))
  314.          (most (if (stringp most-try) most-try (car comps)))
  315.          (most-len (length most))
  316.          (determ (and (> most-len (length name))
  317.               (concat open-bracket-determined
  318.                   (substring most (length name))
  319.                   close-bracket-determined)))
  320.          (open-bracket-prospects "{")
  321.          (close-bracket-prospects "}")
  322.                                         ;"-prospects" - more than one candidate
  323.          (prospects-len 0)
  324.          prospects most-is-exact comp)
  325.     (if (eq most-try t)
  326.         (setq prospects nil)
  327.       (while (and comps (< prospects-len icomplete-prospects-length))
  328.         (setq comp (substring (car comps) most-len)
  329.           comps (cdr comps))
  330.         (cond ((string-equal comp "") (setq most-is-exact t))
  331.           ((member comp prospects))
  332.           (t (setq prospects (cons comp prospects)
  333.                prospects-len (+ (length comp) 1 prospects-len))))))
  334.     (if prospects
  335.         (concat determ
  336.             open-bracket-prospects
  337.             (and most-is-exact ",")
  338.             (mapconcat 'identity
  339.                    (sort prospects (function string-lessp))
  340.                    ",")
  341.             (and comps ",...")
  342.             close-bracket-prospects)
  343.       (concat determ
  344.           " [Matched"
  345.           (let ((keys (and icomplete-show-key-bindings
  346.                    (commandp (intern-soft most))
  347.                    (icomplete-get-keys most))))
  348.             (if keys
  349.             (concat "; " keys)
  350.               ""))
  351.           "]"))))))
  352.  
  353. (if (string-match "XEmacs\\|Lucid" emacs-version)
  354.     (add-hook 'icomplete-minibuffer-setup-hook 'icomplete-exhibit))
  355.  
  356. ;;;_* Local emacs vars.
  357. ;;;Local variables:
  358. ;;;outline-layout: (-2 :)
  359. ;;;End:
  360.  
  361. ;;; icomplete.el ends here
  362.